home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / chars.swg / 0005_Redefine FONT Chars.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  2.7 KB  |  81 lines
  1. {
  2. >> I know this can be done - in fact I've seen posts on it before, but it
  3. >> didn't strike me as something to save at the time. . .
  4. >  Does anyone know how to redefine the Characters used in Text mode?  I
  5. >> don't want to use a whole new set; rather I'd like to change just about a
  6. >> dozen or so Characters to my own.
  7.  
  8. This is a little routine I developed sometime ago to redefine some of the
  9. ascii Chars as 'smileys'. The Arrays of hex values are Character
  10. bitmaps. There is a rather good article about doing this sort of thing in PC
  11. Magazine,Volume 9 number 2 (Jan 30, 1990)
  12. }
  13.  
  14. Program Redefine;
  15.  
  16. Uses
  17.   Dos,Crt;
  18.  
  19. Procedure loadChar;
  20. Const
  21.   numnewChars = 6;
  22. Type
  23.   ByteArray = Array[0..15] of Byte;
  24.   CharArray = Array[1..numnewChars] of Record
  25.     CharNum : Byte;
  26.     CharData : ByteArray;
  27.   end;
  28.  
  29. Const newChars : CharArray = (
  30.    (CharNum : 21;
  31.     CharData : ($00,$00,$E7,$A5,$E7,$00,$00,$08,$18,$38,$00,$00,$C3,$C3,$7E,$00)),
  32.    (Charnum : 4;
  33.     CharData : ($00,$00,$E7,$A5,$E7,$00,$00,$08,$18,$38,$00,$00,$7E,$C3,$C3,$00)),
  34.    (Charnum : 19;
  35.     CharData : ($AA,$AA,$FE,$00,$EE,$AA,$EE,$00,$08,$18,$38,$00,$C6,$C6,$7C,$00)),
  36.    (Charnum : 17;
  37.     CharData : ($03,$07,$FF,$00,$0E,$0A,$0E,$00,$00,$01,$03,$00,$08,$07,$00,$00)),
  38.    (Charnum : 23;
  39.     CharData : ($C0,$E0,$FF,$00,$E0,$A0,$E0,$00,$80,$80,$80,$10,$10,$E0,$00,$00)),
  40.    (Charnum : 24;
  41.     CharData : ($E7,$42,$00,$C3,$A5,$E7,$00,$08,$18,$38,$00,$00,$7E,$FF,$81,$00))
  42.     );
  43.  
  44. Var
  45.   r : Registers;
  46.   i : Byte;
  47.  
  48. begin
  49. for i := 1 to numnewChars do
  50.   With r do
  51.   begin
  52.     ah := $11;             { video sub-Function $11 }
  53.     al := $0;              { Load Chars to table }
  54.     bh := $10;             { number of Bytes per Char }
  55.     bl := 0;               { Character table to edit }
  56.     cx := 1;               { number of Chars we're definig }
  57.     dx := NewChars[i].CharNum;          { ascii value of the Char }
  58.     es := seg(NewChars[i].CharData);    { es:bp --> table we're loading }
  59.     bp := ofs(NewChars[i].CharData);
  60.     intr($10,r);
  61.   end;
  62. end;
  63.  
  64. begin
  65.   loadChar;
  66.   Writeln('Char(21) is now ',chr(21));Writeln;
  67.   Writeln('Char(04) is now ',chr(04));Writeln;
  68.   Writeln('Char(19) is now ',chr(19));Writeln;
  69.   Writeln('Char(17) is now ',chr(17));Writeln;
  70.   Writeln('Char(23) is now ',chr(23));Writeln;
  71.   Writeln('Char(24) is now ',chr(24));Writeln;
  72.   readln;
  73.   Textmode(co80);
  74.   Writeln('Char(21) is now ',chr(21));Writeln;
  75.   Writeln('Char(04) is now ',chr(04));Writeln;
  76.   Writeln('Char(19) is now ',chr(19));Writeln;
  77.   Writeln('Char(17) is now ',chr(17));Writeln;
  78.   Writeln('Char(23) is now ',chr(23));Writeln;
  79.   Writeln('Char(24) is now ',chr(24));Writeln;
  80. end.
  81.